;;; -*- Mode:Lisp; Package:System-Internals; Base:8 -*-
;;; ** (C) Copyright 1980, Massachusetts Institute of Technology
;;;    Enhancements (C) Copyright 1981, Symbolics, Inc.
;;; The Massachusetts Institute of Technology has acquired the rights from Symbolics
;;; to include the Software covered by the foregoing notice of copyright with its
;;; licenses of the Lisp Machine System **

;;; Handler for the serial I/O interface

(DEFUN MAKE-SERIAL-STREAM (&REST KEYWORDS)
  "Make a stream that talks over the serial i//o interface.
Keywords are:
:ASCII-CHARACTERS -- T enables translation between Ascii and Lisp machine character sets
:ASCII-PROTOCOL -- obsolete name for :XON-XOFF-PROTOCOL
:BAUD -- baud rate.  Default is 300.
:BUFFERING-CAPACITY -- number of characters output buffer, over 2.  Only if ASCII-PROTOCOL
:CHECK-FRAMING-ERRORS -- T enables error if break received
:CHECK-OVER-RUN-ERRORS -- T enables error if input characters lost in UART
    (input characters lost due to buffer overflow not detected).
:CHECK-PARITY-ERRORS -- T enables error if wrong parity
:DATA-TERMINAL-READY -- NIL disables DTR output
:DLE-CHARACTER -- data link escape character for synchronous mode
:FORCE-OUTPUT -- NIL means you must :FORCE-OUTPUT to cause transmission,
    T (the default) means an automatic :FORCE-OUTPUT occurs after :TYO/:STRING-OUT
    Using NIL gives faster output.
:INPUT-BUFFER-SIZE -- approximate size to make the input ring buffer, in characters.
:NUMBER-OF-DATA-BITS -- default 7  (doesn't include parity bit)
:NUMBER-OF-STOP-BITS -- default 1
:OUTPUT-BUFFER-SIZE -- approximate size to make the output ring buffer, in characters.
:PARITY -- default :EVEN
:REQUEST-TO-SEND -- NIL disables RTS output
:SYNCHRONOUS-MODE -- T enables synchronous protocol
:SYN1-CHARACTER -- first sync character for synchronous mode
:SYN2-CHARACTER -- second sync character for synchronous mode
:XON-XOFF-PROTOCOL -- T enables XON/XOFF (^S/^Q) control of output"
  (DECLARE (ARGLIST &KEY &OPTIONAL ASCII-CHARACTERS ASCII-PROTOCOL BAUD BUFFERING-CAPACITY
                    CHECK-FRAMING-ERRORS CHECK-OVER-RUN-ERRORS CHECK-PARITY-ERRORS
                    DATA-TERMINAL-READY DLE-CHARACTER FORCE-OUTPUT
                    NUMBER-OF-DATA-BITS NUMBER-OF-STOP-BITS PARITY
                    REQUEST-TO-SEND SYNCHRONOUS-MODE SYN1-CHARACTER SYN2-CHARACTER
                    XON-XOFF-PROTOCOL))
  (INSTANTIATE-FLAVOR (IF (GETL (LOCF KEYWORDS) '(:XON-XOFF-PROTOCOL :ASCII-PROTOCOL))
                          (IF (GET (LOCF KEYWORDS) ':ASCII-CHARACTERS)
                              'SERIAL-ASCII-XON-XOFF-STREAM
                            'SERIAL-XON-XOFF-STREAM)
                        (IF (GET (LOCF KEYWORDS) ':ASCII-CHARACTERS)
                            'SERIAL-ASCII-STREAM
                          'SERIAL-STREAM))
                      (LOCF KEYWORDS)
                      T))

(DEFUN SERIAL-STATUS ()
  "Print out the status of the serial I//O interface."
  (LET ((MODE (SERIAL-READ-MODE))
        (STATUS (%UNIBUS-READ 764162))
        (COMMAND (%UNIBUS-READ 764166))
        (SYNCHRONOUS-P NIL))
    (FORMAT T "~%STATUS ~O, COMMAND ~O~%" STATUS COMMAND)
    (AND (ZEROP (LDB 1002 MODE)) (SETQ SYNCHRONOUS-P T))
    (SELECTQ (LDB 0602 COMMAND)
      (0 )
      (1 (PRINC (IF SYNCHRONOUS-P "syn//dle-stripping " "auto-echo ")))
      (2 (PRINC "local-loop-back "))
      (3 (PRINC "remote-loop-back ")))
    (AND (BIT-TEST 40 COMMAND) (PRINC "request-to-send "))
    (AND (BIT-TEST 2 COMMAND) (PRINC "data-terminal-ready "))
    (AND (BIT-TEST 10 COMMAND) (PRINC (IF SYNCHRONOUS-P "send-dle" "send-break")))
    (FORMAT T "receiver-~[off~;on~] " (LDB 0201 COMMAND))
    (FORMAT T "transmitter-~[off~;on~]~%" (LDB 0001 COMMAND))
    (FORMAT T "interrupt-~[dis~;en~]able " (LDB 0701 (%UNIBUS-READ 764112)))
    (AND (BIT-TEST 200 STATUS) (PRINC "data-set-ready "))
    (AND (BIT-TEST 100 STATUS) (PRINC "carrier-detect "))
    (AND (BIT-TEST 40 STATUS) (PRINC (IF SYNCHRONOUS-P "sync-detect " "break-received ")))
    (AND (BIT-TEST 20 STATUS) (PRINC "receive-overrun "))
    (AND (BIT-TEST 10 STATUS) (PRINC (IF SYNCHRONOUS-P "par-err-or-dle " "parity-error ")))
    (AND (BIT-TEST 4 STATUS) (PRINC "idle//data-set-change "))
    (AND (BIT-TEST 2 STATUS) (PRINC "receive-ready "))
    (AND (BIT-TEST 1 STATUS) (PRINC "transmit-ready "))
    (TERPRI)
    (FORMAT T "~[ILLEGAL~;1~;1.5~;2~] stop bits, " (LDB 1602 MODE))
    (FORMAT T "~[no~;odd~;no~;even~] parity, " (LDB 1402 MODE))
    (FORMAT T "~D data bits, " (+ 5 (LDB 1202 MODE)))
    (FORMAT T "~[synchronous~;asynchronous~;asynchronous//16~;asynchronous//64~]~%"
              (LDB 1002 MODE))
    (FORMAT T "~[external~;internal~] transmit clock, " (LDB 0501 MODE))
    (FORMAT T "~[external~;internal~] receive clock, " (LDB 0401 MODE))
    (FORMAT T "~D baud" (NTH (LDB 0004 MODE) '(50. 75. 110. 134. 150. 300. 600.
                                               1200. 1800. 2000. 2400. 3600.
                                               4800. 7200. 9600. 19200.)))))

(DEFFLAVOR SERIAL-STREAM-MIXIN
           (INPUT-UNIBUS-CHANNEL
            OUTPUT-UNIBUS-CHANNEL
            RANDOM-UNIBUS-CHANNEL
            ;; RANDOM-UNIBUS-CHANNEL is for some serial pci chips which seem to cause
            ;; interrupts on modem transitions (bit 4). This absorbs these interrupts
            ;; to prevent the microcode from bombing because it can't find anyone to
            ;; give the interrupt to.
            (INPUT-BUFFER-SIZE PAGE-SIZE)
            (OUTPUT-BUFFER-SIZE PAGE-SIZE)
            (UART-COMMAND 5)                    ;receive, transmit enable
            (UART-MODES 0)
            (FORCE-OUTPUT T)
            (DLE-CHARACTER 0)
            (SYN1-CHARACTER 0)
            (SYN2-CHARACTER 0)
            (SERIAL-UNRCHF NIL)
            (SERIAL-ERROR-MASK 0))
           (SI:LINE-OUTPUT-STREAM-MIXIN)
  (:REQUIRED-FLAVORS SI:BIDIRECTIONAL-STREAM SI:CHARACTER-STREAM
                     SI:UNBUFFERED-LINE-INPUT-STREAM
                     SI:BASIC-BUFFERED-OUTPUT-STREAM)
  (:INITABLE-INSTANCE-VARIABLES FORCE-OUTPUT DLE-CHARACTER SYN1-CHARACTER SYN2-CHARACTER
                                INPUT-BUFFER-SIZE OUTPUT-BUFFER-SIZE)
  (:INIT-KEYWORDS :CHECK-PARITY-ERRORS :CHECK-OVER-RUN-ERRORS :CHECK-FRAMING-ERRORS
                  :REQUEST-TO-SEND :DATA-TERMINAL-READY :SYNCHRONOUS-MODE
                  :NUMBER-OF-STOP-BITS :PARITY :NUMBER-OF-DATA-BITS :BAUD
                  :XON-XOFF-PROTOCOL :ASCII-PROTOCOL :ASCII-CHARACTERS)
  (:DOCUMENTATION :MIXIN "The guts of RS232 Serial I//O Streams"))

(DEFFLAVOR SERIAL-STREAM () (SERIAL-STREAM-MIXIN
                             SI:BIDIRECTIONAL-STREAM SI:CHARACTER-STREAM
                             SI:UNBUFFERED-LINE-INPUT-STREAM
                             SI:BUFFERED-OUTPUT-STREAM)
  (:DOCUMENTATION :COMBINATION "RS232 Serial I//O Stream, no character-set translation"))

(DEFFLAVOR SERIAL-ASCII-STREAM ()
           (SI:ASCII-TRANSLATING-OUTPUT-STREAM-MIXIN SI:ASCII-TRANSLATING-INPUT-STREAM-MIXIN
            SERIAL-STREAM-MIXIN
            SI:BIDIRECTIONAL-STREAM SI:CHARACTER-STREAM
            SI:UNBUFFERED-LINE-INPUT-STREAM
            SI:BASIC-BUFFERED-OUTPUT-STREAM)
  (:DOCUMENTATION :COMBINATION "RS232 Serial I//O Stream, Ascii character translation"))

;;; Housekeeping methods
(DEFMETHOD (SERIAL-STREAM-MIXIN :INIT) (INIT-PLIST)
  (SERIAL-CHECK-EXISTENCE)                      ;Barf if machine doesn't have serial I/O port
  (LET ((REQUEST-TO-SEND T)                     ;Parse options
        (DATA-TERMINAL-READY T)
        (SYNCHRONOUS-MODE NIL))
    (LOOP FOR (KWD VAL) ON (CDR INIT-PLIST) BY 'CDDR DO
      (SELECTQ KWD
        (:REQUEST-TO-SEND (SETQ REQUEST-TO-SEND VAL))
        (:DATA-TERMINAL-READY (SETQ DATA-TERMINAL-READY VAL))
        (:SYNCHRONOUS-MODE (SETQ SYNCHRONOUS-MODE VAL))))
    (%UNIBUS-WRITE 764166 20)                   ;Reset
    (SERIAL-WRITE-COMMAND UART-COMMAND)         ;Unreset, enable receiver and transmitter
    (SERIAL-WRITE-MODE 60)                      ;Reset modes, set to internal clocks
    ;; Set up modes which want to be specified first
    (SEND SELF ':PUT ':SYNCHRONOUS-MODE SYNCHRONOUS-MODE)
    (SEND SELF ':PUT ':REQUEST-TO-SEND REQUEST-TO-SEND)
    (SEND SELF ':PUT ':DATA-TERMINAL-READY DATA-TERMINAL-READY)
    ;; Default to even parity and 7 data bits,
    ;; but don't check received parity.  This causes the
    ;; input stream to return 7-bit characters, to avoid
    ;; faking out Lisp-machine-oriented programs.
    (SEND SELF ':PUT ':NUMBER-OF-STOP-BITS 1)
    (SEND SELF ':PUT ':PARITY ':EVEN)
    (SEND SELF ':PUT ':NUMBER-OF-DATA-BITS 7)
    (SEND SELF ':PUT ':BAUD 300.)
    ;; Now do :PUT for any necessary options
    (LOOP FOR (KWD VAL) ON (CDR INIT-PLIST) BY 'CDDR
          UNLESS (MEMQ KWD '(:REQUEST-TO-SEND :DATA-TERMINAL-READY :SYNCHRONOUS-MODE
                             :XON-XOFF-PROTOCOL :ASCII-PROTOCOL :BUFFERING-CAPACITY
                             :ASCII-CHARACTERS :FORCE-OUTPUT
                             :DLE-CHARACTER :SYN1-CHARACTER :SYN2-CHARACTER))
            DO (ERRSET (SEND SELF ':PUT KWD VAL) NIL))
    (SEND SELF ':RESET)))                       ;Sets up the Unibus channels

;;; Test existence of device.  If IOB not wired for it, will read back
;;; all zero.  If PCI not plugged in, will read back all ones.
(DEFUN SERIAL-CHECK-EXISTENCE (&AUX ZEROS ONES)
  (%UNIBUS-WRITE 764166 0)
  (SETQ ZEROS (LDB 0010 (%UNIBUS-READ 764166)))
  (%UNIBUS-WRITE 764166 100)
  (SETQ ONES (LDB 0010 (%UNIBUS-READ 764166)))
  (COND ((ZEROP ONES) (FERROR NIL "This IOB does not have serial I/O"))
        ((= ZEROS 377) (FERROR NIL "This IOB does not contain a PCI"))))

;;; Get the various modes, hardware status, etc.
(DEFMETHOD (SERIAL-STREAM-MIXIN :GET) (PROP)
  (LET ((MODE (SERIAL-READ-MODE))
        (STATUS (%UNIBUS-READ 764162))
        (COMMAND (%UNIBUS-READ 764166))
        (SYNCHRONOUS-P NIL))
    (AND (ZEROP (LDB 1002 MODE)) (SETQ SYNCHRONOUS-P T))
    (SELECTQ PROP
      (:DATA-SET-READY (BIT-TEST 200 STATUS))   ;This might want to be wired to CTS?
      (:CARRIER-DETECT (BIT-TEST 100 STATUS))
      (:REQUEST-TO-SEND (BIT-TEST 40 COMMAND))
      (:DATA-TERMINAL-READY (BIT-TEST 2 COMMAND))
      (:NUMBER-OF-STOP-BITS (IF SYNCHRONOUS-P
                                0
                              (NTH (LDB 1602 MODE) '(NIL 1 1.5 2))))
      (:PARITY (NTH (LDB 1402 MODE) '(NIL :ODD NIL :EVEN)))
      (:NUMBER-OF-DATA-BITS (+ 5 (LDB 1202 MODE)))
      (:BAUD (NTH (LDB 0004 MODE) '(50. 75. 110. 134. 150. 300. 600.
                                        1200. 1800. 2000. 2400. 3600.
                                        4800. 7200. 9600. 19200.)))
      (:INPUT-BUFFER-SIZE INPUT-BUFFER-SIZE)
      (:OUTPUT-BUFFER-SIZE INPUT-BUFFER-SIZE)
      (:SYNCHRONOUS-MODE SYNCHRONOUS-P)
      (:SYN1-CHARACTER SYN1-CHARACTER)
      (:SYN2-CHARACTER SYN2-CHARACTER)
      (:DLE-CHARACTER DLE-CHARACTER)
      (:SINGLE-SYNC-CHAR-MODE (AND SYNCHRONOUS-P (BIT-TEST 100000 MODE)))
      (:SYNC-TRANSPARENT-MODE (AND SYNCHRONOUS-P (BIT-TEST 40000 MODE)))
      (:AUTOMATIC-ECHO-MODE (AND (NOT SYNCHRONOUS-P) (= (LDB 0602 COMMAND) 1)))
      (:SYNC-DLE-STRIPPING-MODE (AND SYNCHRONOUS-P (= (LDB 0602 COMMAND) 1)))
      (:LOCAL-LOOP-BACK (= (LDB 0602 COMMAND) 2))
      (:REMOTE-LOOP-BACK (= (LDB 0602 COMMAND) 3))
      (:RECEIVE-ENABLE (BIT-TEST 4 COMMAND))
      (:TRANSMIT-ENABLE (BIT-TEST 1 COMMAND))
      (:CHECK-PARITY-ERRORS (BIT-TEST 10 SERIAL-ERROR-MASK))
      (:CHECK-OVER-RUN-ERRORS (BIT-TEST 20 SERIAL-ERROR-MASK))
      (:CHECK-FRAMING-ERRORS (BIT-TEST 40 SERIAL-ERROR-MASK))
      (OTHERWISE (FERROR NIL "~S not a valid property name" PROP)))))

(DEFUN SERIAL-READ-MODE ()
  (%UNIBUS-READ 764166)                         ;reset MODE1/MODE2 phase
  (DPB (%UNIBUS-READ 764164) 1010 (%UNIBUS-READ 764164)))

;;; Change modes, hardware status, etc.
(DEFMETHOD (SERIAL-STREAM-MIXIN :PUT) (PROP VAL)
  (LET ((MODE (SERIAL-READ-MODE))
        (SYNCHRONOUS-P NIL))
    (AND (ZEROP (LDB 1002 MODE)) (SETQ SYNCHRONOUS-P T))
    (SELECTQ PROP
      (:REQUEST-TO-SEND (SERIAL-WRITE-COMMAND (LOGIOR (IF VAL 40 0) UART-COMMAND)))
      (:DATA-TERMINAL-READY (SERIAL-WRITE-COMMAND (LOGIOR (IF VAL 2 0) UART-COMMAND)))
      (:NUMBER-OF-STOP-BITS
       (SETQ VAL (SELECT VAL
                   (1 1)
                   (1.5 2)
                   (2 3)
                   (T (FERROR NIL ":NUMBER-OF-STOP-BITS is ~S, not 1, 1.5, or 2." VAL))))
       (SERIAL-WRITE-MODE (DPB VAL 1602 MODE)))
      (:PARITY
       (SETQ VAL (SELECTQ VAL
                   (NIL 0)
                   (:ODD 1)
                   (:EVEN 3)
                   (T (FERROR NIL ":PARITY is ~S, not NIL, :ODD, or :EVEN." VAL))))
       (SERIAL-WRITE-MODE (DPB VAL 1402 MODE)))
      (:NUMBER-OF-DATA-BITS
       (SETQ VAL (IF ( 5 VAL 8)
                     (- VAL 5)
                   (FERROR NIL ":NUMBER-OF-DATA-BITS is ~D, not 5, 6, 7, or 8." VAL)))
       (SERIAL-WRITE-MODE (DPB VAL 1202 MODE)))
      (:BAUD
       (SETQ VAL (FIND-POSITION-IN-LIST VAL
                                        '(50.   75.   110.  134.  150.  300.  600.  1200.
                                          1800. 2000. 2400. 3600. 4800. 7200. 9600. 19200.)))
       (OR VAL (FERROR NIL "Invalid serial stream baud rate, ~D." VAL))
       (SERIAL-WRITE-MODE (DPB VAL 0004 MODE)))
      (:INPUT-BUFFER-SIZE (SETQ INPUT-BUFFER-SIZE VAL))
      (:OUTPUT-BUFFER-SIZE (SETQ INPUT-BUFFER-SIZE VAL))
      (:SYNCHRONOUS-MODE
       (AND VAL (SERIAL-WRITE-SYNC-CHARS SYN1-CHARACTER SYN2-CHARACTER DLE-CHARACTER))
       (SERIAL-WRITE-MODE (DPB (IF VAL 0 1) 1002 MODE)))
      (:SYN1-CHARACTER
       (SETQ SYN1-CHARACTER VAL)
       (SERIAL-WRITE-SYNC-CHARS SYN1-CHARACTER SYN2-CHARACTER DLE-CHARACTER))
      (:SYN2-CHARACTER
       (SETQ SYN2-CHARACTER VAL)
       (SERIAL-WRITE-SYNC-CHARS SYN1-CHARACTER SYN2-CHARACTER DLE-CHARACTER))
      (:DLE-CHARACTER
       (SETQ DLE-CHARACTER VAL)
       (SERIAL-WRITE-SYNC-CHARS SYN1-CHARACTER SYN2-CHARACTER DLE-CHARACTER))
      (:SINGLE-SYNC-CHAR-MODE
       (SERIAL-WRITE-MODE (DPB (IF VAL 1 0) 1701 MODE)))
      (:SYNC-TRANSPARENT-MODE
       (SERIAL-WRITE-MODE (DPB (IF VAL 1 0) 1601 MODE)))
      (:AUTOMATIC-ECHO-MODE
       (AND SYNCHRONOUS-P (FERROR NIL "does not apply in synchronous mode"))
       (SERIAL-WRITE-COMMAND (DPB (IF VAL 1 0) 0602 UART-COMMAND)))
      (:SYNC-DLE-STRIPPING-MODE
       (AND (NOT SYNCHRONOUS-P) (FERROR NIL "does not apply in asynchronous mode"))
       (SERIAL-WRITE-COMMAND (DPB (IF VAL 1 0) 0602 UART-COMMAND)))
      (:LOCAL-LOOP-BACK
       (SERIAL-WRITE-COMMAND (DPB (IF VAL 2 0) 0602 UART-COMMAND)))
      (:REMOTE-LOOP-BACK
       (SERIAL-WRITE-COMMAND (DPB (IF VAL 3 0) 0602 UART-COMMAND)))
      (:RECEIVE-ENABLE
       (SERIAL-WRITE-COMMAND (DPB (IF VAL 1 0) 0201 UART-COMMAND)))
      (:TRANSMIT-ENABLE
       (SERIAL-WRITE-COMMAND (DPB (IF VAL 1 0) 0001 UART-COMMAND)))
      (:CHECK-PARITY-ERRORS
       (SETQ SERIAL-ERROR-MASK (DPB (IF VAL 1 0) 0301 SERIAL-ERROR-MASK)))
      (:CHECK-OVER-RUN-ERRORS
       (SETQ SERIAL-ERROR-MASK (DPB (IF VAL 1 0) 0401 SERIAL-ERROR-MASK)))
      (:CHECK-FRAMING-ERRORS
       (SETQ SERIAL-ERROR-MASK (DPB (IF VAL 1 0) 0501 SERIAL-ERROR-MASK)))
      (OTHERWISE (FERROR NIL "~S not a valid property name" PROP)))))

(DECLARE-FLAVOR-INSTANCE-VARIABLES (SERIAL-STREAM-MIXIN)
(DEFUN SERIAL-WRITE-COMMAND (CMD)
  (SETQ UART-COMMAND CMD)                       ;remember it
  (IF (VARIABLE-BOUNDP OUTPUT-UNIBUS-CHANNEL)
      (%P-DPB-OFFSET (LOGAND CMD 376) %%Q-POINTER OUTPUT-UNIBUS-CHANNEL
                     %UNIBUS-CHANNEL-OUTPUT-TURNOFF-BITS))
  (%UNIBUS-WRITE 764166 CMD)))

(DEFUN SERIAL-WRITE-SYNC-CHARS (SYN1 SYN2 DLE)
  (%UNIBUS-READ 764166)                         ;reset MODE1/MODE2 phase
  (%UNIBUS-WRITE 764162 SYN1)
  (%UNIBUS-WRITE 764162 SYN2)
  (%UNIBUS-WRITE 764162 DLE))

(DECLARE-FLAVOR-INSTANCE-VARIABLES (SERIAL-STREAM-MIXIN)
(DEFUN SERIAL-WRITE-MODE (MODE)
  (SETQ UART-MODES MODE)                        ;remember it
  (%UNIBUS-READ 764166)                         ;reset MODE1/MODE2 phase
  (%UNIBUS-WRITE 764164 (LDB 1010 MODE))
  (%UNIBUS-WRITE 764164 MODE)))

(DEFMETHOD (SERIAL-STREAM-MIXIN :CLOSE) (&OPTIONAL ABORT-P)
  (IF (AND (NOT ABORT-P) (VARIABLE-BOUNDP OUTPUT-UNIBUS-CHANNEL) OUTPUT-UNIBUS-CHANNEL)
      (SEND SELF ':FINISH))
  (%UNIBUS-WRITE 764112 (DPB 0 0701 (%UNIBUS-READ 764112)))     ;Turn off interrupt
  (WHEN (VARIABLE-BOUNDP INPUT-UNIBUS-CHANNEL)
    (RETURN-UNIBUS-CHANNEL (PROG1 INPUT-UNIBUS-CHANNEL
                                  (VARIABLE-MAKUNBOUND INPUT-UNIBUS-CHANNEL))))
  (WHEN (VARIABLE-BOUNDP OUTPUT-UNIBUS-CHANNEL)
    (RETURN-UNIBUS-CHANNEL (PROG1 OUTPUT-UNIBUS-CHANNEL
                                  (VARIABLE-MAKUNBOUND OUTPUT-UNIBUS-CHANNEL))))
  (WHEN (VARIABLE-BOUNDP RANDOM-UNIBUS-CHANNEL)
    (RETURN-UNIBUS-CHANNEL (PROG1 RANDOM-UNIBUS-CHANNEL
                                  (VARIABLE-MAKUNBOUND RANDOM-UNIBUS-CHANNEL)))))

(DEFMETHOD (SERIAL-STREAM-MIXIN :FINISH) ()
  (PROCESS-WAIT "Serial Finish"
                #'(LAMBDA (CHAN) (NOT (UNIBUS-CHANNEL-NOT-EMPTY CHAN)))
                OUTPUT-UNIBUS-CHANNEL))

;This fully resets the hardware.
(DEFMETHOD (SERIAL-STREAM-MIXIN :CLEAR-INPUT) ()
  (SEND SELF ':RESET NIL))

(DEFMETHOD (SERIAL-STREAM-MIXIN :RESET) (&OPTIONAL (ABORT-OUTPUT :ABORT))
    (SEND SELF :CLOSE ABORT-OUTPUT)             ;Get rid of unibus channels if any
    ;; Reset the stupid error flags
    (%UNIBUS-WRITE 764166 (LOGIOR 20 UART-COMMAND))
    (%UNIBUS-WRITE 764166 UART-COMMAND)
    (SERIAL-WRITE-MODE UART-MODES)              ;Restore mode registers
    (%UNIBUS-READ 764160)                       ;Flush buffered input character if any
    (SETQ INPUT-UNIBUS-CHANNEL
          (GET-UNIBUS-CHANNEL 264 764162 2 764160 2
                              (CEILING INPUT-BUFFER-SIZE PAGE-SIZE))
          OUTPUT-UNIBUS-CHANNEL
          (GET-UNIBUS-CHANNEL 264 764162 1 764160 1
                              (CEILING OUTPUT-BUFFER-SIZE PAGE-SIZE)
                              764166 (LOGAND UART-COMMAND 376))
          ;;Some UARTS cause interrupts on modem changes.  RANDOM-UNIBUS-CHANNEL absorbs
          ;; these to prevent microcode from bombing because it cant find anyone to give
          ;; interrupt to.  "DATA" is CSR itself.
          RANDOM-UNIBUS-CHANNEL
          (GET-UNIBUS-CHANNEL 264 764162 4 764162 1 1)) ;; PAGE-SIZE
    (%UNIBUS-WRITE 764112 (DPB 1 0701 (%UNIBUS-READ 764112))))  ;Turn on interrupt

;;; Stream Input Protocol
(DEFMETHOD (SERIAL-STREAM-MIXIN :TYI) (&OPTIONAL IGNORE)
  (COND ((NULL SERIAL-UNRCHF)
         (PROCESS-WAIT "Serial TYI" #'UNIBUS-CHANNEL-NOT-EMPTY INPUT-UNIBUS-CHANNEL)
         (MULTIPLE-VALUE-BIND (CH STATUS) (READ-UNIBUS-CHANNEL INPUT-UNIBUS-CHANNEL)
           (SETQ CH (LOGAND 377 CH))
           (COND ((BIT-TEST SERIAL-ERROR-MASK STATUS)
                  ;; Reset the stupid error flags
                  (%UNIBUS-WRITE 764166 (LOGIOR 20 UART-COMMAND))
                  (%UNIBUS-WRITE 764166 UART-COMMAND)
                  (CERROR T NIL NIL
                          "Serial input ~:[framing ~]~:[over-run ~]~:[parity ~]error: ~O"
                          (ZEROP (LOGAND 40 STATUS SERIAL-ERROR-MASK))
                          (ZEROP (LOGAND 20 STATUS SERIAL-ERROR-MASK))
                          (ZEROP (LOGAND 10 STATUS SERIAL-ERROR-MASK))
                          CH)))
           CH))
        (T (PROG1 SERIAL-UNRCHF (SETQ SERIAL-UNRCHF NIL)))))

(DEFMETHOD (SERIAL-STREAM-MIXIN :UNTYI) (CHAR)
  (SETQ SERIAL-UNRCHF CHAR))

(DEFMETHOD (SERIAL-STREAM-MIXIN :LISTEN) ()
  (OR (NOT (NULL SERIAL-UNRCHF))
      (UNIBUS-CHANNEL-NOT-EMPTY INPUT-UNIBUS-CHANNEL)))

(DEFMETHOD (SERIAL-STREAM-MIXIN :TYI-NO-HANG) ()
  (AND (UNIBUS-CHANNEL-NOT-EMPTY INPUT-UNIBUS-CHANNEL)
       (SEND SELF ':TYI)))

;;; Next three methods implement buffered output stream protocol
(DEFMETHOD (SERIAL-STREAM-MIXIN :NEW-OUTPUT-BUFFER) ()
  (PROCESS-WAIT "Serial TYO" #'UNIBUS-CHANNEL-NOT-FULL OUTPUT-UNIBUS-CHANNEL)
  (MULTIPLE-VALUE-BIND (START END) (UNIBUS-CHANNEL-SPACE-AVAILABLE OUTPUT-UNIBUS-CHANNEL)
    (VALUES OUTPUT-UNIBUS-CHANNEL START END)))

(DEFMETHOD (SERIAL-STREAM-MIXIN :SEND-OUTPUT-BUFFER) (IGNORE NEW-INDEX)
  (UNIBUS-CHANNEL-ADVANCE OUTPUT-UNIBUS-CHANNEL NEW-INDEX)
  (%UNIBUS-WRITE 764166 UART-COMMAND))  ;Enables the transmitter

(DEFMETHOD (SERIAL-STREAM-MIXIN :DISCARD-OUTPUT-BUFFER) (IGNORE)
  NIL)

;;; The inherited method for this (from BUFFERED-OUTPUT-STREAM) does not work
;;; because we have a single circular buffer, so just punt.
;;; This is used by :FRESH-LINE.
(DEFMETHOD (SERIAL-STREAM-MIXIN :LAST-CHAR-OUTPUT) () NIL)

;;; For compatibility with the old unbuffered stream, we provide a mode where
;;; you don't have to do :FORCE-OUTPUT manually, and even make it the default.
;;; This should be a mixin, but it was too inconvenient to have so many flavors
;;; for such a trivial thing.
(DEFMETHOD (SERIAL-STREAM-MIXIN :AFTER :TYO) (IGNORE)
  (AND FORCE-OUTPUT (SEND SELF ':FORCE-OUTPUT)))

(DEFMETHOD (SERIAL-STREAM-MIXIN :AFTER :STRING-OUT) (&REST IGNORE)
  (AND FORCE-OUTPUT (SEND SELF ':FORCE-OUTPUT)))

(DEFFLAVOR SERIAL-XON-XOFF-MIXIN ((BUFFERING-CAPACITY 10.)) ()
  (:INITABLE-INSTANCE-VARIABLES BUFFERING-CAPACITY)
  (:REQUIRED-FLAVORS SERIAL-STREAM-MIXIN)
  (:DOCUMENTATION :MIXIN "Serial output controlled by XON and XOFF characters.
   BUFFERING-CAPACITY is one half the allowed number of characters between XOFF checks."))

(DEFFLAVOR SERIAL-XON-XOFF-STREAM () (SERIAL-XON-XOFF-MIXIN SERIAL-STREAM)
  (:DOCUMENTATION :COMBINATION
                  "RS232 Serial I//O Stream, XON//XOFF, no character translation"))

(DEFFLAVOR SERIAL-ASCII-XON-XOFF-STREAM () (SERIAL-XON-XOFF-MIXIN SERIAL-ASCII-STREAM)
  (:DOCUMENTATION :COMBINATION
                  "RS232 Serial I//O Stream, XON//XOFF, ascii character translation"))

(DEFMETHOD (SERIAL-XON-XOFF-MIXIN :NEW-OUTPUT-BUFFER) ()
  (PROCESS-WAIT "Serial TYO"
                #'UNIBUS-CHANNEL-NOT-FULL OUTPUT-UNIBUS-CHANNEL BUFFERING-CAPACITY)
  (LET ((CH (SEND SELF ':TYI-NO-HANG)))
    (SELECTQ CH
      (21 NIL)                                  ;Spurious ^Q - ignore.
      (23                                       ;XOFF (^S)
        (LOOP DO (PROCESS-WAIT "Serial XON" #'UNIBUS-CHANNEL-NOT-EMPTY INPUT-UNIBUS-CHANNEL)
              UNTIL (= (SEND SELF ':TYI) 21)))  ;XON (^Q)
      (NIL )
      (OTHERWISE (FERROR NIL "Unexpected character ~O received" CH))))
  (MULTIPLE-VALUE-BIND (START END) (UNIBUS-CHANNEL-SPACE-AVAILABLE OUTPUT-UNIBUS-CHANNEL)
    (IF (> (- END START) BUFFERING-CAPACITY)
        (SETQ END (+ START BUFFERING-CAPACITY)))
    (VALUES OUTPUT-UNIBUS-CHANNEL START END)))

(COMPILE-FLAVOR-METHODS SERIAL-STREAM SERIAL-ASCII-STREAM
                        SERIAL-XON-XOFF-STREAM SERIAL-ASCII-XON-XOFF-STREAM)
